home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / slib / scaoutp.scm < prev    next >
Encoding:
Text File  |  1994-05-25  |  2.4 KB  |  82 lines
  1. ;;; "scaoutp.scm" syntax-case output
  2. ;;; Written by Robert Hieb & Kent Dybvig
  3.  
  4. ;;; This file was munged by a simple minded sed script since it left
  5. ;;; its original authors' hands.  See syncase.sh for the horrid details.
  6.  
  7. ;;; output.ss
  8. ;;; Robert Hieb & Kent Dybvig
  9. ;;; 92/06/18
  10.  
  11. ; The output routines can be tailored to feed a specific system or compiler.
  12. ; They are set up here to generate the following subset of standard Scheme:
  13.  
  14. ;  <expression> :== <application>
  15. ;                |  <variable>
  16. ;                |  (set! <variable> <expression>)
  17. ;                |  (define <variable> <expression>)
  18. ;                |  (lambda (<variable>*) <expression>)
  19. ;                |  (lambda <variable> <expression>)
  20. ;                |  (lambda (<variable>+ . <variable>) <expression>)
  21. ;                |  (letrec (<binding>+) <expression>)
  22. ;                |  (if <expression> <expression> <expression>)
  23. ;                |  (begin <expression> <expression>)
  24. ;                |  (quote <datum>)
  25. ; <application> :== (<expression>+)
  26. ;     <binding> :== (<variable> <expression>)
  27. ;    <variable> :== <symbol>
  28.  
  29. ; Definitions are generated only at top level.
  30.  
  31. (define syncase:build-application
  32.    (lambda (fun-exp arg-exps)
  33.       `(,fun-exp ,@arg-exps)))
  34.  
  35. (define syncase:build-conditional
  36.    (lambda (test-exp then-exp else-exp)
  37.       `(if ,test-exp ,then-exp ,else-exp)))
  38.  
  39. (define syncase:build-lexical-reference (lambda (var) var))
  40.  
  41. (define syncase:build-lexical-assignment
  42.    (lambda (var exp)
  43.       `(set! ,var ,exp)))
  44.  
  45. (define syncase:build-global-reference (lambda (var) var))
  46.  
  47. (define syncase:build-global-assignment
  48.    (lambda (var exp)
  49.       `(set! ,var ,exp)))
  50.  
  51. (define syncase:build-lambda
  52.    (lambda (vars exp)
  53.       `(lambda ,vars ,exp)))
  54.  
  55. (define syncase:build-improper-lambda
  56.    (lambda (vars var exp)
  57.       `(lambda (,@vars . ,var) ,exp)))
  58.  
  59. (define syncase:build-data
  60.    (lambda (exp)
  61.       `(quote ,exp)))
  62.  
  63. (define syncase:build-identifier
  64.    (lambda (id)
  65.       `(quote ,id)))
  66.  
  67. (define syncase:build-sequence
  68.    (lambda (exps)
  69.       (if (null? (cdr exps))
  70.           (car exps)
  71.           `(begin ,(car exps) ,(syncase:build-sequence (cdr exps))))))
  72.  
  73. (define syncase:build-letrec
  74.    (lambda (vars val-exps body-exp)
  75.       (if (null? vars)
  76.           body-exp
  77.           `(letrec ,(map list vars val-exps) ,body-exp))))
  78.  
  79. (define syncase:build-global-definition
  80.    (lambda (var val)
  81.       `(define ,var ,val)))
  82.